﻿Public Class Form1
    Structure AngleStruc
        Dim DD As Single        Dim mm As Single        Dim ss As Single    End Structure
    Dim i%, j%, k%, ScaleStr$(8), ScaleID%
    Dim SclLngDif(8) As AngleStruc, SclLatDif(8) As AngleStruc
    Dim PointLng As AngleStruc, PointLat As AngleStruc
    Dim a%, b%, c%, d%
    Dim FriRow$, FriCol$, RowLat$, ColLng$
    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
        '设置比例尺下拉框
        ScaleStr$(1) = "1:100万"
        ScaleStr$(2) = "1:50万"
        ScaleStr$(3) = "1:25万"
        ScaleStr$(4) = "1:10万"
        ScaleStr$(5) = "1:5万"
        ScaleStr$(6) = "1:2.5万"
        ScaleStr$(7) = "1:1万"
        ScaleStr$(8) = "1:5000"
        For i As Integer = 1 To 8
            ComboBox1.Items.Add(ScaleStr(i))
        Next
        SclLngDif(1).DD = 6 : SclLngDif(1).mm = 0 : SclLngDif(1).ss = 0
        SclLatDif(1).DD = 4 : SclLatDif(1).mm = 0 : SclLatDif(1).ss = 0

        SclLngDif(2).DD = 3 : SclLngDif(2).mm = 0 : SclLngDif(2).ss = 0
        SclLatDif(2).DD = 2 : SclLatDif(2).mm = 0 : SclLatDif(2).ss = 0

        SclLngDif(3).DD = 1 : SclLngDif(3).mm = 30 : SclLngDif(3).ss = 0
        SclLatDif(3).DD = 1 : SclLatDif(3).mm = 0 : SclLatDif(3).ss = 0

        SclLngDif(4).DD = 0 : SclLngDif(4).mm = 30 : SclLngDif(4).ss = 0
        SclLatDif(4).DD = 0 : SclLatDif(4).mm = 20 : SclLatDif(4).ss = 0

        SclLngDif(5).DD = 0 : SclLngDif(5).mm = 15 : SclLngDif(5).ss = 0
        SclLatDif(5).DD = 0 : SclLatDif(5).mm = 10 : SclLatDif(5).ss = 0

        SclLngDif(6).DD = 0 : SclLngDif(6).mm = 7 : SclLngDif(6).ss = 30
        SclLatDif(6).DD = 0 : SclLatDif(6).mm = 5 : SclLatDif(6).ss = 0

        SclLngDif(7).DD = 0 : SclLngDif(7).mm = 3 : SclLngDif(7).ss = 45
        SclLatDif(7).DD = 0 : SclLatDif(7).mm = 2 : SclLatDif(7).ss = 30

        SclLngDif(8).DD = 0 : SclLngDif(8).mm = 1 : SclLngDif(8).ss = 52.5
        SclLatDif(8).DD = 0 : SclLatDif(8).mm = 1 : SclLatDif(8).ss = 15
        '设置控件状态
        TextBox1.Enabled = False : TextBox2.Enabled = False
        TextBox3.Enabled = False : TextBox4.Enabled = False : TextBox5.Enabled = False
        TextBox6.Enabled = False : TextBox7.Enabled = False : TextBox8.Enabled = False
        TextBox7.Enabled = False : TextBox8.Enabled = False : TextBox9.Enabled = False
        TextBox10.Enabled = False : TextBox11.Enabled = False : TextBox12.Enabled = False
        TextBox13.Enabled = False : TextBox14.Enabled = False : TextBox15.Enabled = False
        Button1.Enabled = False : Button2.Enabled = False
    End Sub
    Private Sub ComboBox1_SelectedValueChanged(sender As Object, e As EventArgs) Handles ComboBox1.SelectedValueChanged
        For i As Integer = 1 To 8            If ComboBox1.Text = ScaleStr$(i) Then
                TextBox1.Text = Str(SclLngDif(i).DD) & "°" & Str(SclLngDif(i).mm) & "′" & Str(SclLngDif(i).ss) & "″"                TextBox2.Text = Str(SclLatDif(i).DD) & "°" & Str(SclLatDif(i).mm) & "′" & Str(SclLatDif(i).ss) & "″"            End If        Next        TextBox3.Enabled = True : TextBox4.Enabled = True : TextBox5.Enabled = True
        TextBox6.Enabled = True : TextBox7.Enabled = True : TextBox8.Enabled = True        Button1.Enabled = True ： Button2.Enabled = True
    End Sub
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim LatDif!, LngDif!
        '判断
        If IsNumeric(TextBox3.Text) = False Or IsNumeric(TextBox4.Text) = False Or IsNumeric(TextBox5.Text) = False Then
            MsgBox("输入点经度格式错误！", vbOKOnly + vbCritical + vbDefaultButton1, "错误提示")
            Exit Sub
        End If
        If (TextBox3.Text < 0 Or TextBox3.Text > 180) Then
            MsgBox("输入经度的度超出范围！", vbOKOnly + vbCritical + vbDefaultButton1, "错误提示")
            Exit Sub
        End If
        If (TextBox4.Text < 0 Or TextBox4.Text > 60) Then
            MsgBox("输入经度的分超出范围！", vbOKOnly + vbCritical + vbDefaultButton1, "错误提示")
            Exit Sub
        End If
        If (TextBox5.Text < 0 Or TextBox5.Text > 60) Then
            MsgBox("输入经度的秒超出范围！", vbOKOnly + vbCritical + vbDefaultButton1, "错误提示")
            Exit Sub
        End If        PointLng.DD = TextBox3.Text : PointLng.mm = TextBox4.Text : PointLng.ss = TextBox5.Text        If IsNumeric(TextBox6.Text) = False Or IsNumeric(TextBox7.Text) = False Or IsNumeric(TextBox8.Text) = False Then            MsgBox("输入点纬度格式错误！", 0 + 16, "错误提示")            Exit Sub        End If
        If (TextBox6.Text < 0 Or TextBox6.Text > 180) Then
            MsgBox("输入纬度的度超出范围！", vbOKOnly + vbCritical + vbDefaultButton1, "错误提示")
            Exit Sub
        End If
        If (TextBox7.Text < 0 Or TextBox7.Text > 60) Then
            MsgBox("输入纬度的分超出范围！", vbOKOnly + vbCritical + vbDefaultButton1, "错误提示")
            Exit Sub
        End If
        If (TextBox8.Text < 0 Or TextBox8.Text > 60) Then
            MsgBox("输入纬度的秒超出范围！", vbOKOnly + vbCritical + vbDefaultButton1, "错误提示")
            Exit Sub
        End If        PointLat.DD = TextBox6.Text : PointLat.mm = TextBox7.Text : PointLat.ss = TextBox8.Text

        a = Int(PointLat.DD / 4) + 1
        b = Int(PointLng.DD / 6) + 31
        TextBox9.Text = a : TextBox12.Text = b

        For i = 1 To 8            If ComboBox1.Text = ScaleStr$(i) Then
                ScaleID = i
                Exit For
            End If
        Next
        '确定首字母和比例尺字母
        TextBox11.Text = Chr(64 + a) : TextBox14.Text = Chr(64 + ScaleID)
        LatDif = SclLatDif(ScaleID).DD * 3600 + SclLatDif(ScaleID).mm * 60 + SclLatDif(ScaleID).ss
        LngDif = SclLngDif(ScaleID).DD * 3600 + SclLngDif(ScaleID).mm * 60 + SclLngDif(ScaleID).ss
        c = 4 * 3600 / LatDif - Int(((PointLat.DD * 3600 + PointLat.mm * 60 + PointLat.ss) Mod (4 * 3600)) / LatDif)
        d = 1 + Int(((PointLng.DD * 3600 + PointLng.mm * 60 + PointLng.ss) Mod (6 * 3600)) / LngDif)
        TextBox10.Text = c : TextBox13.Text = d
        FriRow$ = Chr(64 + a) : FriCol$ = Trim(Str(b)) : RowLat$ = Trim(Str(c)) : ColLng$ = Trim(Str(d))
        If Len(RowLat$) = 1 Then
            RowLat$ = "00" + RowLat$
        ElseIf Len(RowLat$) = 2 Then
            RowLat$ = "0" + RowLat$
        End If
        If Len(ColLng$) = 1 Then
            ColLng$ = "00" + ColLng$
        ElseIf Len(ColLng$) = 2 Then
            ColLng$ = "0" + ColLng$
        End If
        TextBox15.Text = FriRow$ + FriCol$ + Chr(64 + ScaleID) + RowLat$ + ColLng$
    End Sub
    '清空
    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
        TextBox3.Text = "" : TextBox4.Text = "" : TextBox5.Text = ""
        TextBox6.Text = "" : TextBox7.Text = "" : TextBox8.Text = ""
    End Sub
End Class
